home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH3 / SRC / PALPOPUP.FRM < prev    next >
Text File  |  1996-01-09  |  3KB  |  125 lines
  1. VERSION 4.00
  2. Begin VB.Form PalettePopup 
  3.    AutoRedraw      =   -1  'True
  4.    BorderStyle     =   1  'Fixed Single
  5.    ClientHeight    =   3600
  6.    ClientLeft      =   2505
  7.    ClientTop       =   1575
  8.    ClientWidth     =   3600
  9.    ControlBox      =   0   'False
  10.    Height          =   4005
  11.    Left            =   2445
  12.    LinkTopic       =   "Form1"
  13.    MaxButton       =   0   'False
  14.    MinButton       =   0   'False
  15.    ScaleHeight     =   3600
  16.    ScaleWidth      =   3600
  17.    Top             =   1230
  18.    Width           =   3720
  19. End
  20. Attribute VB_Name = "PalettePopup"
  21. Attribute VB_Creatable = False
  22. Attribute VB_Exposed = False
  23. Option Explicit
  24.  
  25. Private Const NO_COLOR = -1
  26.  
  27. Private selected_color As Integer
  28. Private colors(0 To 255) As Long
  29. Private dx As Single
  30. Private dy As Single
  31.  
  32. ' ***********************************************
  33. ' Fill the form with the palette colors and
  34. ' record their values in the colors array.
  35. ' ***********************************************
  36. Public Sub Fill()
  37. Dim i As Integer
  38. Dim j As Integer
  39. Dim clr As Integer
  40.  
  41.     clr = 0
  42.     For i = 0 To 15
  43.         For j = 0 To 15
  44.             Line (j * dx, i * dy)-Step(dx, dy), _
  45.                 clr + &H1000000, BF
  46.             colors(i * 16 + j) = Point(j * dx, i * dy)
  47.             clr = clr + 1
  48.         Next j
  49.     Next i
  50.  
  51.     selected_color = NO_COLOR
  52. End Sub
  53.  
  54. ' ***********************************************
  55. ' Return the RGB value of the selected color.
  56. ' ***********************************************
  57. Property Get SelectedColor() As Long
  58.     SelectedColor = colors(selected_color)
  59. End Property
  60.  
  61. ' ***********************************************
  62. ' Select the indicated color.
  63. ' ***********************************************
  64. Private Sub SelectColor(ByVal i As Integer, ByVal j As Integer)
  65. Dim oldi As Integer
  66. Dim oldj As Integer
  67. Dim oldmode As Integer
  68.  
  69.     oldmode = DrawMode
  70.     DrawMode = vbInvert
  71.     
  72.     ' Erase the old selection if there is one.
  73.     If selected_color <> NO_COLOR Then
  74.         oldi = selected_color \ 16
  75.         oldj = selected_color Mod 16
  76.         Line (oldj * dx, oldi * dy)-Step(dx, dy)
  77.         Line (oldj * dx, (oldi + 1) * dy)-Step(dx, -dy)
  78.     End If
  79.  
  80.     selected_color = i * 16 + j
  81.     
  82.     ' Highlight the new selection.
  83.     If selected_color <> NO_COLOR Then
  84.         Line (j * dx, i * dy)-Step(dx, dy)
  85.         Line (j * dx, (i + 1) * dy)-Step(dx, -dy)
  86.     End If
  87.     
  88.     DrawMode = oldmode
  89. End Sub
  90. ' ***********************************************
  91. ' Select a color with the indicated RGB value.
  92. ' ***********************************************
  93. Property Let SelectedColor(ByVal clr As Long)
  94. Dim i As Integer
  95.  
  96.     ' Take off the &H2000000.
  97.     clr = clr And &HFFFFFF
  98.     
  99.     ' Find a matching palette entry.
  100.     For i = 0 To 255
  101.         If colors(i) = clr Then Exit For
  102.     Next i
  103.     
  104.     If i > 255 Then
  105.         ' Unhighlight the previous selection.
  106.         SelectColor 0, NO_COLOR
  107.     Else
  108.         ' Highlight the new selection.
  109.         SelectColor i \ 16, i Mod 16
  110.     End If
  111. End Property
  112.  
  113.  
  114. Private Sub Form_Load()
  115.     dx = ScaleWidth / 16
  116.     dy = ScaleHeight / 16
  117. End Sub
  118.  
  119. Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  120.     SelectColor Y \ dy, X \ dx
  121.     Me.Hide
  122. End Sub
  123.  
  124.  
  125.